home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 27 / CU Amiga Magazine's Super CD-ROM 27 (1998)(EMAP Images)(GB)[!][issue 1998-10].iso / CUCD / Programming / JForth / Extras / SysGen / ANSI < prev    next >
Encoding:
Text File  |  1992-01-22  |  3.6 KB  |  175 lines
  1. \ Use ANSI command sequences for fancy text displays.
  2. \
  3. \ Provide access to several CSI sequences provided by
  4. \ the 'console device' specifically the ability to set the
  5. \ forground and background colors and change the text
  6. \ characteristics (plain, bold, italic, inverse)
  7.  
  8. \ for further information, refer to the Amiga Rom Kernel Manual, Chapter 4,
  9. \ "CONSOLE DEVICE"... of particular interest may be section 
  10. \ 4.6 "CONTROL SEQUENCES FOR SCREEN OUTPUT"
  11.  
  12. \ 00001 PLB 1/22/92 Add or subtract N from OUTinstead of 1 in
  13. \            ANSI.FORWARDS and ANSI.BACKWARDS
  14.  
  15. ANEW TASK-ANSI
  16.  
  17. : ANSITYPE  ( adr cnt -- , update out )
  18.     out @ >r  type r> out !  ;
  19.  
  20. : ANSI"   ( send following to screen preceeded with esc sequence )
  21.     $ 9b  [compile] literal
  22.     compile emit
  23.     [compile] $"
  24.     compile count
  25.     compile ansitype
  26. ; immediate
  27.  
  28. decimal
  29.  
  30. $ 9B constant CSI        \ the AMIGA "control sequence introducer!"
  31.  
  32. : .DECIMAL  ( n -- , output decimal number without spaces )
  33.     base @ >r
  34.     decimal n>text type  ( output N )
  35.     r> base !
  36. ;
  37.  
  38. : >STYLE  ( n -- , select graphic rendition )
  39.     out @ >r
  40.     CSI emit   .decimal
  41.     ascii m emit
  42.     r> out !
  43. ;
  44.  
  45. \ text types --------------------
  46.  
  47. : PLAIN      ( -- )  0 >style  ;
  48. : BOLD       ( -- )  1 >style  ;
  49. : ITALIC     ( -- )  3 >style  ;
  50. : UNDERSCORE ( -- )  4 >style  ;
  51. : INVERSE    ( -- )  7 >style  ;
  52.  
  53. \ forground color ---------------
  54.  
  55.  
  56. : F:0    30 >style ;
  57. : F:1    31 >style ;
  58. : F:2    32 >style ;
  59. : F:3    33 >style ;
  60. : F:4    34 >style ;
  61. : F:5    35 >style ;
  62. : F:6    36 >style ;
  63. : F:7    37 >style ;
  64.  
  65. \ bakground color ---------------
  66.  
  67.  
  68. : B:0    40 >style ;
  69. : B:1    41 >style ;
  70. : B:2    42 >style ;
  71. : B:3    43 >style ;
  72. : B:4    44 >style ;
  73. : B:5    45 >style ;
  74. : B:6    46 >style ;
  75. : B:7    47 >style ;
  76.  
  77.  
  78. : GOTOXY   ( x y -- , move text cursor )
  79.     over >r
  80.     csi emit
  81.     .decimal
  82.     ascii ; emit
  83.     .decimal
  84.     ascii H emit
  85.     r> out !  \ set out to x
  86. ;
  87.  
  88. : CLEARSCREEN cls ;
  89.  
  90.  
  91. : ANSI.1C ( char -- )
  92.     out @
  93.     CSI emit
  94.     swap emit
  95.     out !
  96. ;
  97.  
  98. : ANSI.NC ( N char -- )
  99.     out @ >r
  100.     CSI emit
  101.     swap .decimal
  102.     emit
  103.     r> out !
  104. ;
  105.  
  106. : ANSI.INSERT ( N -- , insert character )
  107.     $ 40 ansi.nc
  108. ;
  109.  
  110. \ Cursor movement commands.
  111. : ANSI.UP ( N -- )
  112.     $ 41 ansi.nc
  113. ;
  114.  
  115. : ANSI.DOWN ( N -- )
  116.     $ 42 ansi.nc
  117. ;
  118.  
  119. : ANSI.FORWARDS ( N -- )
  120.     dup $ 43 ansi.nc
  121.     out +! \ 00001
  122. ;
  123.  
  124. : ANSI.BACKWARDS ( N -- )
  125.     dup $ 44 ansi.nc
  126.     out @ swap - 0 max out ! \ 00001
  127. ;
  128.  
  129. : ANSI.DELETE ( N -- )
  130.     $ 50 ansi.nc
  131. ;
  132.  
  133. : ANSI.ERASE.EOL ( -- , erase to end of line )
  134.     $ 4b ansi.1c
  135. ;
  136.  
  137. : ANSI.PARSE.SKR  ( -- key-code, get packed key sequence)
  138. \ This is called after receiving a char=155 decimal
  139. \ It will eat keys and return a FKEY index
  140. \ 0 = error
  141. \ 1 = function key 1, 11 = shift 1,
  142. \ 21 = cursor-up, 22 = cursor-down,
  143. \ 23 = cursor-right, 24 = cursor-left,
  144. \ 25 = shift-cursor-up, 26,27,28 (shifted v < >)
  145. \ 29 = help
  146.     key dup 65 68 within?  ( -- char flag )
  147.     IF ( simple cursor )
  148.         44 -
  149.     ELSE  ( -- char )
  150.         dup 48 57 within?  ( function key )
  151.     IF ( -- char ) dup 49 =  ( maybe shifted? )
  152.             IF  drop key dup ascii ~ =
  153.                 IF drop ( fkey 2) 2
  154.                 ELSE key drop  ( get rid of ~ )
  155.                    37 -  ( shifted )
  156.                 THEN
  157.             ELSE key drop 47 -
  158.             THEN
  159.         ELSE ( other key )
  160.             CASE
  161.             ascii ? OF 29 key drop ENDOF
  162.             ascii T OF 25 ENDOF
  163.             ascii S OF 26 ENDOF
  164.         bl OF key CASE
  165.                 ascii @ OF 27 ENDOF
  166.                 ascii A OF 28 ENDOF
  167.                 0 swap
  168.                 ENDCASE
  169.                ENDOF
  170.                0 swap
  171.             ENDCASE
  172.         THEN
  173.     THEN
  174. ;
  175.